home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor1
/
fromasc.lst
< prev
next >
Wrap
File List
|
1991-01-29
|
5KB
|
97 lines
ASC\->
80000: 02D9D ! Program
80005: 1592D ; Set last RPL token to <0h> and verify DEPTH >= 1
8000A: 18FB2 ; Check arguments for type
8000F: 0400D ; <3h>
80014: 02D9D ! Program
80019: [...] ! # 0000h
80027: 06657 ; Internal NEWOB
8002C: 62747 ; Internal SWAP and DUP
80031: 05636 ; Internal SIZE (1:String) -> System Binary
80036: 03188 ; Internal DUP
8003B: [...] ! <41h>
80045: 03EF7 ; Internal / (2:System Binary,1:System Binary) -> (2:rem,1:div)
8004A: 60F9B ; drop level two object
8004F: 03DE0 ; Internal - (2:System Binary,1:System Binary)
80054: 04017 ; <4h>
80059: 031AC ; Internal DUP2
8005E: 03CE4 ; if TOS-1 < TOS (System Binary) -> True/False
80063: 61993 ; if pop TOS = True, then do next/return, else skip next
80068: 02D9D ! Program
8006D: 03258 ; Internal DROP2
80072: 60F9B ; drop level two object
80077: [...] ! "Invalid String"
8009D: 1A339 ; DOERR (XLIB 2 42)
800A2: 0312B ! End Marker
800A7: 03DE0 ; Internal - (2:System Binary,1:System Binary)
800AC: 055DF ; ""
800B1: 032C2 ; Internal OVER
800B6: 61C1C ; allocate nibbles (2:sized object,1:System Binary)
800BB: 03223 ; Internal SWAP
; *** (4:#0000h,3:orig str,2:alloc str,1:size) ***
800C0: 02DCC ! Code
800C5: 000AF ! 175 nibbles (next RPL at 80174)
800CA: 8F14660 GOSBVL 06641 ; MC: pop TOS (System Binary) -> A.A
800D1: CC A=A-1 A ; A.A = size-1
800D3: 8FB9760 GOSBVL 0679B ; MC: Save D,B,D1,D0 (uses C)
800DA: 840 ST=0 0 ; start new object phase
800DD: 3104 LCHEX 40 ! "@"
800E1: AE7 D=C B ; D (characters remaining in line) = 64
800E4: D8 B=A A ; B.A = size-1
800E6: 143 A=DAT1 A ; A.A = adr of alloc str
800E9: 130 D0=A ; D0 = adr of alloc str
800EC: 169 D0=D0+ 10 ; D0 = adr of new object (alloc str data)
800EF: 132 AD0EX ; A.A = adr of new object
800F2: 130 D0=A ; ...
800F5: 141 DAT1=A A ; adjust stack to new object
800F8: 174 D1=D1+ 5 ; A = adr of orig str
800FB: 143 A=DAT1 A ; ...
800FE: 174 D1=D1+ 5 ; C = adr of checksum
80101: 147 C=DAT1 A ; ...
80104: 06 RSTK=C ; save checksum adr
80106: 131 D1=A ; D1 = adr of orig str
80109: 179 D1=D1+ 10 ; D1 = adr of orig str data
8010C: A6F D=D-1 B ; count character in line
8010F: 5C0 GONC 8011C ; go if not EOL
80112: 31F3 LCHEX 3F ! "?" ; reset D for new line (D=63)
80116: AE7 D=C B ; ...
80119: 171 D1=D1+ 2 ; skip EOL character
8011C: AE2 C=0 B ; convert character to nibble
8011F: 14F C=DAT1 B
80122: 8082103 LAHEX 30 ! "0"
80129: B62 C=C-A B
8012C: 8082190 LAHEX 09 ! "."
80133: 9EEB0 ?A>=C B
GOYES 80141
80138: 808207 LAHEX 7
8013E: B62 C=C-A B
80141: 15C0 DAT0=C 1 ; store nibble into new object
80145: 160 D0=D0+ 1 ; next nibble in new object
80148: 171 D1=D1+ 2 ; next character in orig str
8014B: CD B=B-1 A ; decr characters remaining
8014D: 5EB GONC 8010C ; go if more
80150: 870A1 ?ST=1 0 ; exit if checksum in progress
GOYES 8016D
80155: 3430000 LCHEX 00003 ; B.A = 3 (size of checksum - 1)
8015C: D5 B=C A ; ...
8015E: 07 C=RSTK ; C = adr of checksum
80160: 134 D0=C ; D0 = adr of checksum data
80163: 169 D0=D0+ 10 ; ...
80166: 850 ST=1 0 ; start of checksum phase
80169: 62AF GOTO 8010C ; go process checksum
8016D: 8D34150 GOVLNG 05143 ; MC: Restore D,B,D1,D0 (C=D0), Clear Carry and continue RPL
. . . . . . ! End of Code
; *** (3:checksum,2:orig str,1:new object) ***
80174: 03188 ; Internal DUP
80179: 05944 ; Internal BYTES (non-ROM objects) -> (2:System Binary,1:Binary Integer)
8017E: 60F9B ; drop level two object
80183: 60FBB ; Internal 4 ROLL
80188: 63CFE ; if SAME, then do next/return, else skip next
8018D: 60F9B ; drop level two object
80192: 03244 ; Internal DROP
80197: [...] ! "Invalid String"
801BD: 1A339 ; DOERR (XLIB 2 42)
801C2: 0312B ! End Marker
801C7: 0312B ! End Marker